Pascal Super Library/Pascal Super Library (CW International)(1997).bin/DELPHI32/DISK_UTL/SHOWMAN/FILEINFO.PAS

Pascal/Delphi Source File | 1996-05-25 | 7KB | 227 lines

unit FileInfo;

interface

uses
  Classes;

type
  TScanCallback = procedure (const status: string); stdcall;

  {forward class declaration}
  TDirectoryData = class;

  TDirectoryList = class (TStringList)
  private
    Ftotal_bytes: integer;                // count of bytes here and below
    Ftotal_files: integer;                // count of files here and below
    Ftotal_dirs: integer;                 // count of directories here and below
    Fdirectory_name: string;              // full path specification
    Fparent_directory: TDirectoryList;    // pointer to previous dir, or nil
  public
    constructor Create (const Parent: TDirectoryList;
                        const Name: string);
    procedure SetDirectoryName (const Name: string);
    function GetDirectoryName: string;
    function GetTotalBytes: integer;
    function GetTotalDirectories: integer;
    function GetTotalFiles: integer;
    function GetParentDirectoryList: TDirectoryList;
    procedure scan (var stop_requested: boolean;
                    const cluster_size: integer;
                    Callback: TScanCallback);
  end;

  TDirectoryData = class
  private
    Fbytes: integer;
    Fowner_directory: TDirectoryList;   // pointer to current dir list, or nil
    Fsub_directory: TDirectoryList;     // pointer to sub-dir list, or nil
  public
    function GetBytes: integer;
    function GetSubDirectoryList: TDirectoryList;
    function GetParentDirectoryList: TDirectoryList;
    constructor Create (const Size: integer;
                        const OwnerDirectoryList: TDirectoryList;
                        const SubDirectoryList: TDirectoryList);
    destructor Destroy;  override;
  end;


implementation

uses
  SysUtils, Forms;

{methods for TDirectoryData}
constructor TDirectoryData.Create (const Size: integer;
                                   const OwnerDirectoryList: TDirectoryList;
                                   const SubDirectoryList: TDirectoryList);
begin
  inherited Create;
  Fowner_directory := OwnerDirectoryList;
  Fsub_directory := SubDirectoryList;
  Fbytes := Size;
end;

destructor TDirectoryData.Destroy;
{must dispose of sub-directories as well as main entry}
begin
  if Fsub_directory <> nil then
    begin
    Fsub_directory.Destroy;
    Fsub_directory := nil;
    end;
  Inherited Destroy;
end;

function TDirectoryData.GetBytes: integer;
begin
  Result := Fbytes;
end;

function TDirectoryData.GetSubDirectoryList: TDirectoryList;
begin
  Result := Fsub_directory;
end;

function TDirectoryData.GetParentDirectoryList: TDirectoryList;
begin
  Result := Fowner_directory.GetParentDirectoryList;
end;


{methods for TDirectoryList}
constructor TDirectoryList.Create (const Parent: TDirectoryList;
                                   const Name: string);
{as standard string list, but allow duplicates, stores name and backlink}
begin
  inherited Create;
  Sorted := False;
  Ftotal_dirs := 0;
  Ftotal_bytes := 0;
  Ftotal_files := 0;
  Fparent_directory := Parent;
  Fdirectory_name := Name;
end;

procedure TDirectoryList.SetDirectoryName (const Name: string);
begin
  Clear;
  Fdirectory_name := Name;
end;

function TDirectoryList.GetTotalBytes: integer;
begin
  Result := Ftotal_bytes;
end;

function TDirectoryList.GetTotalDirectories: integer;
begin
  Result := Ftotal_dirs;
end;

function TDirectoryList.GetTotalFiles: integer;
begin
  Result := Ftotal_files;
end;

function TDirectoryList.GetParentDirectoryList: TDirectoryList;
begin
  Result := Fparent_directory;
end;

function TDirectoryList.GetDirectoryName: string;
begin
  Result := Fdirectory_name;
end;

procedure TDirectoryList.scan (var stop_requested: boolean;
                               const cluster_size: integer;
                               Callback: TScanCallback);

  function allocated_bytes (file_size, cluster_size: integer): integer;
  var
     fill: integer;
     mask: integer;
  begin
    fill := cluster_size - 1;
    mask := not fill;
    Result := (file_size + fill) and mask;
  end;

var
   s: TSearchRec;
   files_to_find: string;
   sub_dir_name: string;
   sub_dir: TDirectoryList;
   next_entry: TDirectoryData;
   bytes_below: integer;
   dirs_below: integer;
   files_below: integer;
   true_size: integer;
   continue: boolean;
begin
  Ftotal_bytes := 0;
  Ftotal_dirs := 0;
  Ftotal_files := 0;
  Callback ('Scanning ' + Fdirectory_name + '...');
  Application.ProcessMessages;
  if FindFirst (Fdirectory_name + '*.*', faAnyFile, s) = 0 then
  repeat
    if stop_requested then Exit;
    with s do
      begin
      if (Attr and faDirectory) <> 0
      then
        begin
        Inc (Ftotal_files);
        // file is sub-directory - but ignore the parent and local backlink
        if (Name = '.') or (Name = '..')
        then
        else
          begin
          Inc (Ftotal_dirs);
          // form new full sub-directory name, with the trailing '\'
          sub_dir_name := Fdirectory_name + Name + '\';
          // allocate a new directory list, insert a record
          // emulating the parent directory
          sub_dir := TDirectoryList.Create (Self, sub_dir_name);
          sub_dir.AddObject ('..', TDirectoryData.Create (0, sub_dir, nil));
          // make the inserted name start with a '\'
          sub_dir_name := '\' + Name;
          // allocate a new entry for the current scan, find out
          // how many bytes and files are in the sub-tree
          next_entry := TDirectoryData.Create (Size, Self, sub_dir);
          with sub_dir do
            begin
            scan (stop_requested, cluster_size, Callback);
            bytes_below := Ftotal_bytes;
            dirs_below := Ftotal_dirs;
            files_below := Ftotal_files;
            // set the size found in this sub-tree and insert the
            // new entry into the current list
            next_entry.Fbytes := bytes_below;
            end;
          AddObject (sub_dir_name, next_entry);
          Inc (Ftotal_bytes, bytes_below);    // bump total bytes found at this
          Inc (Ftotal_dirs, dirs_below);      // (and lower) levels
          Inc (Ftotal_files, files_below);
          end;
        end
      else
        begin
        // for a normal (or hidden) file, insert the name into the list
        true_size := allocated_bytes (Size, cluster_size);
        AddObject (Name, TDirectoryData.Create (true_size, Self, nil));
        Inc (Ftotal_bytes, true_size);
        Inc (Ftotal_files);
        end;
      end;
  until FindNext (s) <> 0;
  FindClose (s);
end;

end.